home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / bipl.zip / PROGS.ZIP / IPXREF.ICN < prev    next >
Text File  |  1992-11-26  |  7KB  |  235 lines
  1. ############################################################################
  2. #
  3. #    File:     ipxref.icn
  4. #
  5. #    Subject:  Program to cross reference Icon program
  6. #
  7. #    Author:   Allan J. Anderson
  8. #
  9. #    Date:     June 10, 1988
  10. #
  11. ###########################################################################
  12. #  
  13. #     This program cross-references Icon programs. It lists the
  14. #  occurrences of each variable by line number. Variables are listed
  15. #  by procedure or separately as globals.  The options specify the
  16. #  formatting of the output and whether or not to cross-reference
  17. #  quoted strings and non-alphanumerics. Variables that are followed
  18. #  by a left parenthesis are listed with an asterisk following the
  19. #  name.  If a file is not specified, then standard input is cross-
  20. #  referenced.
  21. #  
  22. #  Options: The following options change the format defaults:
  23. #  
  24. #       -c n The column width per line number. The default is 4
  25. #            columns wide.
  26. #  
  27. #       -l n The starting column (i.e. left margin) of the line
  28. #            numbers.  The default is column 40.
  29. #  
  30. #       -w n The column width of the whole output line. The default
  31. #            is 80 columns wide.
  32. #  
  33. #     Normally only alphanumerics are cross-referenced. These
  34. #  options expand what is considered:
  35. #  
  36. #       -q   Include quoted strings.
  37. #  
  38. #       -x   Include all non-alphanumerics.
  39. #  
  40. #  Note: This program assumes the subject file is a valid Icon pro-
  41. #  gram. For example, quotes are expected to be matched.
  42. #  
  43. ############################################################################
  44. #
  45. #  Bugs:
  46. #
  47. #     In some situations, the output is not properly formatted.
  48. #
  49. ############################################################################
  50. #
  51. #  Links: options
  52. #
  53. ############################################################################
  54.  
  55. link options
  56.  
  57. global resword, linenum, letters, alphas, var, buffer, qflag, infile, xflag
  58. global inmaxcol, inlmarg, inchunk, localvar, lin
  59.  
  60. record procrec(pname,begline,lastline)
  61.  
  62. procedure main(args)
  63.  
  64.    local word, w2, p, prec, i, L, ln, switches, nfile
  65.  
  66.    resword := ["break","by","case","default","do","dynamic","else","end",
  67.       "every","fail","global","if","initial","link", "local","next","not",
  68.       "of","procedure", "record","repeat","return","static","suspend","then",
  69.       "to","until","while"]
  70.    linenum := 0
  71.    var := table()        # var[variable[proc]] is list of line numbers
  72.    prec := []            # list of procedure records
  73.    localvar := []        # list of local variables of current routine
  74.    buffer := []            # a put-back buffer for getword
  75.    proc := "global"
  76.    letters := &letters ++ '_'
  77.    alphas := letters ++ &digits
  78.  
  79.    switches := options(args,"qxw+l+c+")
  80.  
  81.    if \switches["q"] then qflag := 1
  82.    if \switches["x"] then xflag := 1
  83.    inmaxcol := \switches["w"]
  84.    inlmarg := \switches["l"]
  85.    inchunk := \switches["c"]
  86.    infile := open(args[1],"r")     # could use some checking
  87.  
  88.    while word := getword() do
  89.       if word == "link" then {
  90.          buffer := []
  91.          lin := ""
  92.          next
  93.          }
  94.       else if word == "procedure" then {
  95.          put(prec,procrec("",linenum,0))
  96.          proc := getword() | break
  97.          p := pull(prec)
  98.          p.pname := proc
  99.          put(prec,p)
  100.          }
  101.       else if word == ("global" | "link" | "record") then {
  102.          word := getword() | break
  103.          addword(word,"global",linenum)
  104.          while (w2 := getword()) == "," do {
  105.             if word == !resword then break
  106.             word := getword() | break
  107.             addword(word,"global",linenum)
  108.             }
  109.          put(buffer,w2)
  110.          }
  111.       else if word == ("local" | "dynamic" | "static") then {
  112.          word := getword() | break
  113.          put(localvar,word)
  114.          addword(word,proc,linenum)
  115.          while (w2 := getword()) == "," do {
  116.             if word == !resword then break
  117.             word := getword() | break
  118.             put(localvar,word)
  119.             addword(word,proc,linenum)
  120.             }
  121.          put(buffer,w2)
  122.          }
  123.       else if word == "end" then {
  124.          proc := "global"
  125.          localvar := []
  126.          p := pull(prec)
  127.          p.lastline := linenum
  128.          put(prec,p)
  129.          }
  130.       else if word == !resword then 
  131.          next
  132.       else {
  133.          ln := linenum
  134.          if (w2 := getword()) == "(" then
  135.             word ||:= " *"            # special mark for procedures
  136.          else
  137.             put(buffer,w2)            # put back w2
  138.          addword(word,proc,ln)
  139.          }
  140.    every write(!format(var))
  141.    write("\n\nprocedures:\tlines:\n")
  142.    L := []
  143.    every p := !prec do
  144.       put(L,left(p.pname,16," ") || p.begline || "-" || p.lastline)
  145.    every write(!sort(L))
  146. end
  147.  
  148. procedure addword(word,proc,lineno)
  149.    if any(letters,word) | \xflag then {
  150.       /var[word] := table()
  151.       if /var[word]["global"] | (word == !\localvar) then {
  152.          /(var[word])[proc] := [word,proc]
  153.          put((var[word])[proc],lineno)
  154.          }
  155.       else {
  156.          /var[word]["global"] := [word,"global"]
  157.          put((var[word])["global"],lineno)
  158.          }
  159.       }
  160. end
  161.  
  162. procedure getword()
  163.    local j, c
  164.    static i, nonwhite
  165.    initial nonwhite := ~' \t\n'
  166.  
  167.    repeat {
  168.       if *buffer > 0 then return get(buffer)
  169.       if /lin | i = *lin + 1 then
  170.          if lin := read(infile) then {
  171.             i := 1
  172.             linenum +:= 1
  173.             }
  174.          else fail
  175.       if i := upto(nonwhite,lin,i) then {   # skip white space
  176.          j := i
  177.          if lin[i] == ("'" | "\"") then {   # don't xref quoted words
  178.             if /qflag then {
  179.                c := lin[i]
  180.                i +:= 1
  181.                repeat
  182.                   if i := upto(c ++ '\\',lin,i) + 1 then
  183.                      if lin[i - 1] == c then break
  184.                      else i +:= 1
  185.                   else {
  186.                      i := 1
  187.                      linenum +:= 1
  188.                      lin := read(infile) | fail
  189.                      }
  190.                }
  191.             else i +:= 1
  192.             }
  193.          else if lin[i] == "#" then {    # don't xref comments; get next line
  194.             i := *lin + 1
  195.             }
  196.          else if i := many(alphas,lin,i) then
  197.             return lin[j:i]
  198.          else {
  199.             i +:= 1
  200.             return lin[i - 1]
  201.             }
  202.          }
  203.       else
  204.          i := *lin + 1
  205.    }       # repeat
  206. end
  207.  
  208. procedure format(T)
  209.    local V, block, n, L, lin, maxcol, lmargin, chunk, col
  210.    initial {
  211.       maxcol := \inmaxcol | 80
  212.       lmargin := \inlmarg | 40
  213.       chunk := \inchunk | 4
  214.       }
  215.    L := []
  216.    col := lmargin
  217.    every V := !T do
  218.       every block := !V do {
  219.          lin := left(block[1],16," ") || left(block[2],lmargin - 16," ")
  220.          every lin ||:= center(block[3 to *block],chunk," ") do {
  221.             col +:= chunk
  222.             if col >= maxcol - chunk then {
  223.                lin ||:= "\n\t\t\t\t\t"
  224.                col := lmargin
  225.                }
  226.             }
  227.          if col = lmargin then lin := lin[1:-6] # came out exactly even
  228.          put(L,lin)
  229.          col := lmargin
  230.          }
  231.    L := sort(L)
  232.    push(L,"variable\tprocedure\t\tline numbers\n")
  233.    return L
  234. end
  235.